home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Graphismes / Bitmap / NIH Image 1.59 / Macros / LUT Macros < prev    next >
Text File  |  1995-01-19  |  10KB  |  479 lines
  1. macro 'Export LUT [E]';
  2. {Copies the current look-up table to a text window.}
  3. var
  4.   i:integer;
  5.   v:real;
  6.   tab:string;
  7. begin
  8.   RequiresVersion(1.54);
  9.   NewTextWindow('LUT',200,400);
  10.   tab:=chr(9);
  11.   for i:=0 to 255 do
  12.     Writeln(i:4,tab,RedLut[i]:4,tab,GreenLut[i]:4,tab,BlueLut[i]:4);
  13. end;
  14.  
  15. macro 'Import Text LUT';
  16. {
  17. Imports a LUT stored as three column (red, green, blue)
  18. text file. If there are four columns then the first column
  19. is assumed to conatin sequence numbers and is ignored.
  20. }
  21. var
  22.   i,r,g,b, width, height, start, row:integer;
  23. begin
  24.   RequiresVersion(1.53);
  25.   SetImport('Text');
  26.   Import('');
  27.   GetPicSize(width,height);
  28.   if width=3 then begin
  29.     r:=0;
  30.     g:=1;
  31.     b:=2
  32.   end else if width=4 then begin
  33.       r:=1;
  34.       g:=2;
  35.       b:=3
  36.   end else begin
  37.     PutMessage('The text file must have either 3 or 4 columns.');
  38.     exit;
  39.   end;
  40.   if height=255 then
  41.     start:=1
  42.   else if height=256 then
  43.       start:=0
  44.   else begin
  45.       PutMessage('The text file must have either 255 or 256 rows.');
  46.       exit;
  47.    end;
  48.   i:=start;
  49.   row:=0;
  50.   repeat
  51.     RedLut[i]:=GetPixel(r,row);
  52.     GreenLut[i]:=GetPixel(g,row);
  53.     BlueLut[i]:=GetPixel(b,row);
  54.     if (i mod 10) = 0 then UpdateLUT;
  55.     i:=i+1;
  56.     row:=row+1;
  57.   until row>=height;
  58.   UpdateLUT;
  59. end;
  60.  
  61. macro 'Invert LUT [I]';
  62. var
  63.   i:integer;
  64. begin
  65.   for i:=1 to 254 do begin
  66.     RedLUT[i]:=255-RedLut[i];
  67.     GreenLUT[i]:=255-GreenLut[i];
  68.     BlueLUT[i]:=255-BlueLut[i];
  69.   end;
  70.   UpdateLUT;
  71. end;
  72.  
  73.  
  74. macro 'Log Tranform';
  75. var
  76.   i,v:integer;
  77.   scale:real;
  78. BEGIN
  79.   scale := 255.0 / ln(255.0);
  80.   for i:=1 to 254 DO begin
  81.     v := 255-round(ln(i) * scale);
  82.     RedLUT[i]:=v;
  83.     GreenLUT[i]:=v;
  84.     BlueLUT[i]:=v;
  85.   end;
  86.   UpdateLUT;
  87. END.
  88.  
  89.  
  90. macro 'Gamma Tranform╔ [G]';
  91. var
  92.   i,v:integer;
  93.   n,mode,min,max:integer
  94.   gamma,mean:real;
  95. begin
  96.   gamma:=GetNumber('Gamma(0.1-3.0):',2);
  97.   measure;
  98.   GetResults(n,mean,mode,min,max);
  99.   ShowMessage('min=',min:1,'\max=',max:1);
  100.   for i:=1 to 254 DO begin
  101.     if (i>min) and (i<max)
  102.       then v:=exp(gamma*ln((i-min)/(max-min)))*255 {x^y=exp(y*ln(x)}
  103.       else begin
  104.         if i<=min then v:=0 else v:=255;
  105.       end;
  106.     RedLUT[i]:=255-v;
  107.     GreenLUT[i]:=255-v;
  108.     BlueLUT[i]:=255-v;
  109.   end;
  110.   UpdateLUT;
  111. end;
  112.  
  113.  
  114. macro 'Square Transform';
  115. var
  116.   i,v:integer;
  117.   sqr255:real;
  118. BEGIN
  119.   sqr255:=sqr(255.0);
  120.   for i:=1 to 255 DO begin
  121.     v:=round(sqr(i)*255.0/sqr255);
  122.     RedLUT[255-i]:=v;
  123.     GreenLUT[255-i]:=v;
  124.     BlueLUT[255-i]:=v;
  125.   end;
  126.   UpdateLUT;
  127. END.
  128.  
  129. macro 'Parabolic Transform';
  130. { Generates a parabolic LUT}
  131. var
  132.   i,y:integer;
  133.   scale:real;
  134. begin
  135.   scale:=1;
  136.   for i:= 1 to 254 do begin
  137.     y:= (i-127)*(i-127)*scale/64.25;
  138.     if y > 255 then y:=255;
  139.     RedLUT[i]:=y;
  140.     GreenLUT[i]:= y;
  141.     BlueLUT[i]:=y;
  142.   end;
  143.   UpdateLUT;
  144. end;
  145.  
  146. macro 'Square Root Tranform';
  147. var
  148.   i,v:integer;
  149.   sqrt255:real;
  150. BEGIN
  151.   sqrt255:=sqrt(255.0);
  152.   for i:=1 to 255 DO begin
  153.     v:=round(sqrt(i)*255.0/sqrt255);
  154.     RedLUT[255-i]:=v;
  155.     GreenLUT[255-i]:=v;
  156.     BlueLUT[255-i]:=v;
  157.   end;
  158.   UpdateLUT;
  159. END;
  160.  
  161.  
  162. macro 'Reset LUT [R]';
  163. begin
  164.   ResetGrayMap;
  165. end;
  166.  
  167.  
  168. macro 'Plot LUT [P]';
  169. var
  170.   i,xscale,yscale:real;
  171.   width,height,margin,pwidth,pheight:integer;
  172.   xbase,ybase:integer;
  173. begin
  174.   SaveState;
  175.   margin:=25;
  176.   pwidth:=400;
  177.   pheight:=125;
  178.   width:=pwidth+2*margin;
  179.   height:=pheight*3+2*margin;
  180.   SetNewSize(width,height);
  181.   SetBackground(0); 
  182.   MakeNewWindow('LUT');
  183.   xscale:=(pwidth-2)/256;
  184.   yscale:=(pheight-1)/256;
  185.   SetForeground(252);
  186.   xbase:=margin; ybase:=margin;
  187.   MoveTo(xbase,ybase);
  188.   for i:=0 to 255 do
  189.     LineTo(xbase+i*xscale,ybase+RedLUT[i]*yscale);
  190.   SetForeground(255);
  191.   MakeRoi(xbase,ybase,pwidth,pheight);
  192.   FlipVertical;
  193.   DrawBoundary;
  194.   SetForeground(253);
  195.   ybase:=ybase+pheight-1;
  196.   MoveTo(xbase,ybase);
  197.   for i:=0 to 255 do
  198.     LineTo(xbase+i*xscale,ybase+GreenLUT[i]*yscale);
  199.   SetForeground(255);
  200.   MakeRoi(xbase,ybase,pwidth,pheight);
  201.   FlipVertical;
  202.   DrawBoundary;
  203.   SetForeground(254);
  204.   ybase:=ybase+pheight-1;
  205.   MoveTo(xbase,ybase);
  206.   for i:=0 to 255 do
  207.     LineTo(xbase+i*xscale,ybase+BlueLUT[i]*yscale);
  208.   SetForeground(255);
  209.   MakeRoi(xbase,ybase,pwidth,pheight);
  210.   FlipVertical;
  211.   DrawBoundary;
  212.   KillRoi;
  213.   RedLUT[252]:=255; GreenLUT[252]:=0;   BlueLUT[252]:=0;
  214.   RedLUT[253]:=0;   GreenLUT[253]:=255; BlueLUT[253]:=0;
  215.   RedLUT[254]:=0;   GreenLUT[254]:=0;   BlueLUT[254]:=255;
  216.   UpdateLUT;
  217.   SetFont('Geneva');
  218.   SetFontSize(9);
  219.   SetText('Centered');
  220.   MoveTo(margin+4,height-margin+8);
  221.   writeln(0:1:2);
  222.   MoveTo(margin+pwidth,height-margin+8);
  223.   writeln(255:1:2);
  224.   RestoreState;
  225. end;
  226.  
  227.  
  228. macro 'Posterize╔';
  229. var
  230.   level,i:integer
  231.   delta,steps,StepSize,NextStep:real;
  232. begin
  233.   steps:=GetNumber('Number of Gray Steps(2-256):',8);
  234.   StepSize:=256/steps;
  235.   delta:=256/(steps-1);
  236.   NextStep:=trunc(StepSize);
  237.   level:=255;
  238.   for i:=0 to 255 do begin
  239.     if i>=NextStep then begin
  240.       NextStep:=trunc(NextStep+StepSize);
  241.       level:=level-delta;
  242.       UpdateLUT;
  243.     end;
  244.     if level<0 then level:=0;
  245.     RedLUT[i]:=level;
  246.     GreenLUT[i]:=level;
  247.     BlueLUT[i]:=level;
  248.   end;
  249. end;
  250.  
  251.  
  252. macro 'Make Four Ramp LUT';
  253. var
  254.   i,entry:integer;
  255. BEGIN
  256.   entry:=0;
  257.   for i:=0 to 63 DO begin
  258.     RedLUT[entry]:=255-i*4;
  259.     GreenLUT[entry]:=255-i*4;
  260.     BlueLUT[entry]:=255-i*4;
  261.     entry:=entry+1;
  262.   end;
  263.   for i:=0 to 63 DO begin
  264.     RedLUT[entry]:=255-i*4;
  265.     GreenLUT[entry]:=0;
  266.     BlueLUT[entry]:=0;
  267.     entry:=entry+1;
  268.   end;
  269.    for i:=0 to 63 DO begin
  270.     RedLUT[entry]:=0;
  271.     GreenLUT[entry]:=255-i*4;
  272.     BlueLUT[entry]:=0;
  273.     entry:=entry+1;
  274.   end;
  275.   for i:=0 to 63 DO begin
  276.     RedLUT[entry]:=0;
  277.     GreenLUT[entry]:=0;
  278.     BlueLUT[entry]:=255-i*4;
  279.     entry:=entry+1;
  280.   end;
  281.   UpdateLUT;
  282. end.
  283.  
  284.  
  285. macro 'Set Pixels Red╔';
  286. var
  287.  v1,v2,i:integer;
  288. begin
  289.     v1:=GetNumber('Starting Pixel Value(1-254)',10);
  290.     v2:=GetNumber('Ending Pixel Value(1-254)',10);
  291.     if v2<v1 then begin
  292.       PutMessage('Ending value less than starting value.');
  293.       exit;
  294.     end;
  295.     for i:=v1 to v2 do begin
  296.       RedLUT[i]:=255;
  297.       GreenLUT[i]:=0;
  298.       BlueLUT[i]:=0;
  299.     end;
  300.   end;
  301.   UpdateLUT;
  302. end;
  303.  
  304.  
  305. macro 'Nearly Gray LUT╔';
  306. {
  307. Here is a macro that changes the LUT to make the values near 128 fairly visible when making polygon and line selections which use XOR drawing mode.
  308. Play around with it to get better results. It was written on the
  309. (incorrect) assumption that brightness = r+g+b.
  310. j is i xor 255 and also white is 255,255,255 not 0,0,0.
  311. {The brightness of each pixel is not quite right, there is a better way to get different colors with same brightness...)
  312. --Edward J. Huff (huff@mcclb0.med.nyu.edu)
  313. }
  314. var
  315.  i,j,d: integer;
  316. begin
  317.    while (d < 1) or (d > 63) do
  318.      d := GetNumber('Amount of color',20);
  319.   for i := d*2 to 127 do begin
  320.      j := 255 - i; 
  321.      RedLUT[i] := j + d;
  322.      GreenLUT[i] := j + d;
  323.      BlueLUT[i] := j - d*2;
  324.      RedLUT[j] := i - d*2;
  325.      GreenLUT[j] := i + d;
  326.      BlueLUT[j] := i + d;
  327.   end;
  328.   UpdateLUT;
  329. end;
  330.  
  331. macro 'Color Merge Two Images';
  332. {
  333. Merges a "red" image and a "green" image to create a
  334. composite color image. The macro does this by scaling both
  335. images to 0-15, multiplying the second by 16, creating a
  336. single 8-bit by ORing the two 4-bit images, and then
  337. generating a custom red and green LUT to display the
  338. composite image.
  339. }
  340. var
  341.   i,w1,w2,h1,h2,merged:integer;
  342. begin
  343.   SaveState;
  344.   if nPics<>2 then begin
  345.     PutMessage('This macro operates on exactly two images.');
  346.     exit;
  347.   end;
  348.   SelectPic(1);
  349.   GetPicSize(w1,h1);
  350.   SelectPic(2);
  351.   GetPicSize(w2,h2);
  352.   if (w1<>w2) or (h1<>h2) then begin
  353.     PutMessage('The two images must have the same width and height.');
  354.     exit;
  355.   end;
  356.   SetNewSize(w1,h2);
  357.   MakeNewWindow('Merged');
  358.   merged:=PicNumber;
  359.   SelectPic(1);
  360.   SelectAll;
  361.   Copy;
  362.   SelectPic(merged);
  363.   Paste;
  364.   SelectAll;
  365.   MultiplyByConstant(1/16);
  366.   ChangeValues(0,0,1);
  367.   ChangeValues(16,16,15);
  368.   SelectPic(2);
  369.   SelectAll;
  370.   Duplicate('Temp');
  371.   MultiplyByConstant(1/16);
  372.   ChangeValues(16,16,15);
  373.   MultiplyByConstant(16);
  374.   ChangeValues(0,0,1);
  375.   SelectAll;
  376.   Copy;
  377.   SelectPic(merged);
  378.   Paste;
  379.   DoOr;
  380.   for i:=0 to 255 do begin
  381.      RedLut[i]:=(i mod 16)*16;
  382.      GreenLut[i]:=(i div 16)*16;
  383.      BlueLut[i]:=0;
  384.    end;
  385.   UpdateLut;
  386.   SelectPic(nPics);
  387.   Dispose;  {Temp}
  388.   RestoreState;
  389. end;
  390.  
  391.  
  392. macro 'Move Slice Up [U]';
  393. var
  394.   lower,upper:integer;
  395. begin
  396.   GetThresholds(lower,upper);
  397.   lower:=lower-1;
  398.   upper:=upper-1;
  399.   if lower<1 then lower:=1;
  400.   if lower>254 then lower:=254;
  401.   if upper<lower then upper:=lower;
  402.   if upper>254 then upper:=254;
  403.   SetDensitySlice(lower,upper);
  404.   ShowMessage(lower:4,upper:4)
  405. end;
  406.  
  407. macro 'Move Slice Down [D]';
  408. var
  409.   lower,upper:integer;
  410. begin
  411.   GetThresholds(lower,upper);
  412.   lower:=lower+1;
  413.   upper:=upper+1;
  414.   if lower<1 then lower:=1;
  415.   if lower>254 then lower:=254;
  416.   if upper<lower then upper:=lower;
  417.   if upper>254 then upper:=254;
  418.   SetDensitySlice(lower,upper);
  419.   ShowMessage(lower:4,upper:4)
  420. end;
  421.  
  422. macro 'Change One LUT Entry╔';
  423. var
  424.   dn:integer;
  425. begin
  426.   dn:=GetNumber('Gray Value(1-254):',128);
  427.   RedLut[dn]:=GetNumber('Red(0-255):',255);
  428.   GreenLut[dn]:=GetNumber('Green(0-255):',0);
  429.   BlueLut[dn]:=GetNumber('Blue(0-255):',0);
  430.   UpdateLUT;
  431. end;
  432.  
  433. macro 'Sort LUT by Hue';
  434. begin
  435.   SortPalette;
  436. end;
  437.  
  438.  
  439. macro 'Copy Calibration to LUT';
  440. var
  441.    i: integer;
  442.    value: integer;
  443.    scale, max, min: real;
  444. begin
  445.    max:=-999999;
  446.    min:=999999;
  447.    for i:= 0 to 255 do begin
  448.        value:=cvalue(i);
  449.        if value<min then min:=value;
  450.        if value>max then max:=value;
  451.    end;
  452.    scale := 255 / (max - min);
  453.    for i := 0 to 255 do begin
  454.                           value := 255 - round(scale * (cvalue(i) - min));
  455.                                 RedLUT[i] := value;
  456.                                 GreenLUT[i] := value;
  457.                                 BlueLUT[i] := value;
  458.                 end;
  459.                 UpdateLUT;
  460.     end;
  461.  
  462. MACRO 'Adjust Threshold'
  463.   VAR
  464.   level: INTEGER; 
  465. BEGIN
  466.    level:=50;
  467.    ShowMessage('Use shift-key to increase threshold \Use control-key to decrease threshold  \Use option-key when threshold is set'); 
  468.    REPEAT
  469.       IF KeyDown('shift') AND (level<255) THEN level:=level+1;
  470.       IF KeyDown('control') AND (level>0) THEN level:=level-1;
  471.       SetThreshold(level);
  472.    UNTIL KeyDown('option') or Button;
  473.   SetThreshold(-1);
  474. END;
  475.  
  476.  
  477.  
  478.  
  479.